home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / CAD / PKEY11_1.ARJ / RS.LSP < prev    next >
Text File  |  1992-03-14  |  1KB  |  34 lines
  1. ;Room Size program ( and naming ) neat !!
  2. ;
  3. ;                     ********Patrick J. McKee, author********
  4. ;                       ****Copyright 1992, Power Key tm****
  5. ;
  6. (defun c:RS (/ pta ptb ptc ptd X Y X1 Y1 rmsz pl1)
  7. (setq oer *error* *error* err2)
  8. (PROMPT "\n(D)ining room. (S)torage. c(L)oset. ")
  9. (SETQ Cpt(GETSTRING "\n(C)onference. (O)ffice. (K)itchen. (B)ath. (M)aster Bedroom."))
  10. (IF(OR(= Cpt "K")(= cpt "k"))(SETQ CPT '"KITCHEN"))
  11. (IF(OR(= cpt "B")(= cpt "b"))(SETQ CPT '"BATH"))
  12. (IF(OR(= cpt "C")(= cpt "c"))(SETQ CPT '"CONFERENCE"))
  13. (IF(OR(= cpt "O")(= cpt "o"))(SETQ CPT '"OFFICE"))
  14. (IF(OR(= cpt "M")(= cpt "m"))(SETQ CPT '"MASTER BEDROOM"))
  15. (IF(OR(= cpt "D")(= cpt "d"))(SETQ CPT '"DINING ROOM"))
  16. (IF(OR(= cpt "S")(= cpt "s"))(SETQ CPT '"STORAGE"))
  17. (IF(OR(= cpt "L")(= cpt "l"))(SETQ CPT '"CLOSET"))
  18.   (setq pta (getpoint
  19.     "\nPick first corner. : "))
  20.   (setq ptb (getcorner pta
  21.     "\nPick second corner. : "))
  22.   (setq ptc (list (car ptb)(cadr pta)))
  23.   (setq ptd (list (car pta)(cadr ptb)))
  24.   (setq ang (angle pta ptb))
  25.   (setq d1 (/(distance pta ptb) 2))
  26.   (setq cp (polar pta (- ang (dtr 0)) d1))
  27.   (setq X (distance pta ptc))
  28.   (setq Y (distance pta ptd))
  29.   (setq X1 (rtos x 4 0))
  30.   (setq Y1 (rtos y 4 0))
  31.   (setq rmsz (strcat X1 " x " Y1))
  32.   (command "TEXT" "c" cp "0" CPT "text" "" rmsz))
  33. (defun dtr (angg)
  34.   (* pi (/ angg 180.0)))